﻿<%
'
'	七色虎建站系统
'	核心文件F.asp
'	v1.2.6 beta2
'	2011.9.3
'	2012.2.25
'	注：外部不要直接引用hu_前缀的变量或函数

'网站全局配置变量
Dim wapStyle,wapTitle,wapUrl,wapConst,wapReport,wapFavor,wapLink,wapDay,wapDayName,wapHits,wapGuest,wapLast,wapLastc
Dim wapLogin,wapDiscuss,wapLogined,wapLogout,wapAccess
Dim styleBodyColor,styleBodyImage,styleFontSize,styleMainColor,styleMainBorder,styleNavColor,styleNavBorder,styleLinkColor
Dim styleLinkHover,styleTipColor,styleOddColor,styleCssExtend
Dim numTitle,numDiscuss,numList,numArticle,numBbsList,numTopicMin,numTopicMax,numReplyMin,numReplyMax,numHit,numBbsHit
Dim bbsReg,bbsAgree,bbsSid,bbsMsgKeep,bbsIp,bbsEssay,bbsMoney,bbsFileUp,bbsFileSize,bbsFileType,bbsPoint,bbsRegLimit
Dim bbsUserTitle,bbsLevel
Dim adminIpCheck,adminTimeCheck,adminUpload,adminArticle,adminUpdate,adminSize
Dim cssStyle,timeDiff
Dim tplArticle,tplList,tplTopic,tplPost
Dim linkStyle,linkAct,linkJump,linkNum,linkShort,linkHide,linkDelete
Dim amtArt,amtPosts,amtPost,amtPostD,amtPostGood,amtPostGoodD,amtReply,amtComment,amtEssay,amtSign,amtSign7,amtAd,amtReg

'当前时间
Dim time_start,time_now,time_date,time_time
time_start = Timer
time_now = Now
time_date = Date
time_time = Time

'随机
Dim time_r
time_r=Minute(time_now)&Second(time_now)

'产生随机种子
Randomize()

'用户IP
Dim user_ip,user_agent,user_accept,user_ip_agent,user_spider
user_ip_agent = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
user_ip_port = Request.ServerVariables("REMOTE_ADDR")
user_ip=getIP()'取Ip地址
user_agent=getAgent()'取浏览器信息
user_accept=0'是否支持wap2.0 [0为没判断,1为支持1.0,2为支持2.0]
user_spider=0'是否是爬虫 [0为没判断，1为爬虫，2为正常访客]

'系统对象
Dim hu

Dim sid,sid_str,sid_val
'sid = "XXX_1"
'sid_str = "sid=XXX_1"
'sid_val = "XXX"

Dim http_server,http_script,http_query
http_server=Request.ServerVariables("SERVER_NAME")
http_script=Request.ServerVariables("SCRIPT_NAME")
http_query=Request.ServerVariables("QUERY_STRING")

'当前目录地址
Dim http_path
http_path=getServerPath()

'返回页面标识
Dim back_url
back_url=forBackUrl()

'数组保存当前账户会话
Dim user_array(7)
' user_array(0)="0"						'ID
' user_array(1)="游客"					'名称
' user_array(2)="-1"					'等级
' user_array(3)=""						'生日
' user_array(4)="0"						'状态
' user_array(5)="1900-00-00 00:00:00"	'注册时间
' user_array(6)="0"						'性别
' user_array(7)=""						'IP信息

'系统信息
Dim sysver,sysversion,systime
sysver = "1.2.7.307"
sysversion = "v1.2.7 beta 2"
systime = "2012-10-9"

'网站配置
%><!--#include file="config.asp"--><%
'配置出错时启用,降低耦合
'保留必要的,其他写到各自的页面

If wapTitle="" Then wapTitle="无名网站"'网站名称
If wapUrl="" Then wapUrl="74hu.cn"'网站地址
If wapConst="" Then wapConst="left"'网站排版
If bbsSid="" Then bbsSid="sid"'论坛会话标识
If bbsMoney="" Then bbsMoney="金币"'论坛金币名称
If bbsPoint="" Then bbsPoint="积分"'论坛积分名称
If wapReport<>"1" And wapReport<>"0" Then wapReport="1"'全站显示公告
If wapLogin<>"1" And wapLogin<>"0" Then wapLogin="1"'显示注册登录
If bbsIp<>"1" And bbsIp<>"0" Then bbsIp="1"'会员IP检测
If Not ifNum(bbsMsgKeep) Then bbsMsgKeep="10"'消息保存天数
'时间配置
If ifNum(timeDiff) Then
	If timeDiff<>0 Then
		time_now=dateadd("s", timeDiff, time_now)
		time_date=CDate(Year(time_now)&"-"&Month(time_now)&"-"&Day(time_now))
		time_time=CDate(Hour(time_now)&":"&Minute(time_now)&":"&Second(time_now))
	End If
End If

Dim hu_style,hu_badWord,hu_getLeft,hu_idOffset
hu_style = False' 1.0和2.0 xml不全兼容
hu_getLeft = False' 文章调用字数
hu_badWord = "法轮"' 敏感词过滤
'hu_idOffset 会员id偏移值，暂时不做

' 访问控制[超级权限]
Dim hu_access
' 默认所有页面不允许访问
If IsNull(hu_access) Then hu_access = False

If ifNum(numTitle) Then hu_getLeft = True
If wapword<>"" Then hu_badword = hu_badWord &","& wapword

'核心函数
%><!--#include file="libs.asp"--><%

'
' 基本函数，外部可以直接引用
' 要求：共同属性写入底层，这部分只是用于展现
' 函数命名：getMyName,兼容旧系统,暂时没有统一

'显示内容
Sub w(str)'效果不理想,前台已取消这个功能
	Response.Write str
End Sub

'显示内容且停止输出
Sub wn(str)'效果不好,前台已取消这个功能
	Response.Write str
	getClose
	Response.End
End Sub

'网页跳转
Sub r(str)
	Response.Redirect str
End Sub

'改写left 中英文长度取定长修整
Function getLeft(str,length)
	getLeft=hu_left(str,length)
End Function

'获取数据
Function getD(str,def)
	Dim tmp
	tmp=getData(str)
	If tmp="" Then getD=def:Exit Function
	tmp=hu_common(tmp)
	tmp=hu_encode(tmp)
	getD=tmp
End Function

'不过滤获取数据
Function getDD(str,def)
	Dim tmp
	tmp=getData(str)
	If tmp="" Then getDD=def:Exit Function
	getDD=tmp
End Function

'完全过滤获取数据
Function getFilter(str,def)
	Dim tmp
	tmp=getData(str)
	If tmp="" Then getFilter=def:Exit Function
	getFilter=hu_filter(tmp)
End Function

'完全过滤数据
Function setFilter(str)
	setFilter=hu_filter(str)
End Function

'获取数字
Function getN(str,def)
	Dim tmp
	tmp=getData(str)
	If tmp="" Then getN=def:Exit Function
	If Not IsNumeric(tmp) Then getN=def:Exit Function
	getN=int(tmp)'避免非十进制 用clng会溢出
End Function

'从终端获取数据
Function getData(str)
	If hu_isNull(str) Then Exit Function
	Dim tmp
	tmp=Trim(Request.QueryString(str))
	If tmp="" Then tmp=Trim(Request.Form(str))
	' tmp=Replace(tmp,"%0c","<",1,-1,1)
	' tmp=Replace(tmp,"%0e",">",1,-1,1)
	' tmp=Replace(tmp,"%2f","/",1,-1,1)
	getData=tmp
End Function

'敏感词过滤
Function changeWord(str)
	changeWord = hu_changeWord(str,hu_badWord,"**")
End Function

'随机显示字符
Function getRndStr(str,pattern)
	getRndStr=hu_rndObj(str,pattern)
End Function

'获取客户端IP
Function getIP()
   Dim tmp
   tmp = Trim(user_ip_agent)
   If tmp="" Then tmp = Trim(user_ip_port)
   If Instr(tmp,"'")>0 Or tmp="" Then tmp="0.0.0.0"
   getIP = tmp
End Function

'获得浏览器信息
Function getAgent()
	getAgent = Request.ServerVariables("HTTP_USER_AGENT")
End Function

'2.0编辑后写入数据库
Function forSaveByWeb(str)
	If hu_isNull(str) Then Exit Function
	str=Trim(str)
	str=Replace(str,"&nbsp;"," ")
	str=Replace(str,"&amp;","&#38;")
	str=Replace(str,"$$","$")'兼容1.0
	str=Replace(str,"","")
	str=Replace(str,vbnewline,"\\")
	str=Replace(str,VbCrLf,"\\")
	forSaveByWeb=str
End Function

'动态友链
Function getLink(str)
	Dim max,num,arr_
	max=str
	If instr(str,",")>0 Then
		arr_=Split(str,",")
		max=arr_(0)
		num=arr_(1)
	End If
	getLink=toplink(max,num)
End Function

'判断全字母
Function ifLetter(str)
	ifLetter=hu_isLetters(str)
End Function

'判断全数字
Function ifNumeric(str)
	ifNumeric=hu_isNumeric(str)
End Function

'判断全数字,用于快速检查
Function ifNum(str)
	ifNum=hu_isNumber(str)
End Function

'生成验证码
Function getCheckCode()
	randomize
	getCheckCode=Int((9000)*Rnd +1000)'不能做修改,必须保证4位
End Function

'验证登录
Function iflogin()
	iflogin=True
	If user_array(0)=0 Then iflogin=False
End Function

'是否支持wml
Function ifWeb()
	Dim userAccept:userAccept = Session("user_accept")
	If userAccept="" Then
		If user_accept=0 Then'没有session时启用
			Dim agent:agent = user_agent
			ifWeb = False
			user_accept = 1
			Session("user_accept") = "1"
			If InStr(agent,"Mozilla")=0 Then Exit Function
			Select Case True
			Case InStr(agent,"Opera")>0
			Case InStr(agent,"Symbian")>0
			Case InStr(agent,"UC")>0
			Case InStr(agent,"CE")>0
			Case InStr(agent,"SmartPhone")>0
			Case InStr(agent,"NetFront")>0
			Case Else
				ifWeb = True
				user_accept = 2
				Session("user_accept") = "2"
			End Select
		Else
			If user_accept=1 Then
				ifWeb = False
			Else
				ifWeb = True
			End If
		End If
	Else
		If userAccept = "1" Then
			ifWeb = False
		Else
			ifWeb = True
		End If
	End If
End Function

'获取当前目录
Function getServerPath()
	Dim Path_
	Path_="http://" & http_server & http_script
	getServerPath=Left(Path_,InStrRev(Path_,"/"))
End Function

'将当前页面地址转换成特定字符串
Function forBackUrl
	Dim Path_,Url_
	Path_= http_server & http_script & "?_m"& time_r &"=1"
	Url_ = http_query
	If Url_<>"" Then Path_=Path_&"&"&Url_
	Url_=urlEncode(Path_)
	forBackUrl=Url_
End Function

'将指定字符串转换成地址
Function getBackUrl(str)
	str=Trim(str)
	if str<>"" then
		str=nowml(urlDecode(str))
		str="http://"&str
	else
		str=http_path&"?_1"&time_r&"=1"
	end if
	getBackUrl=str
End Function

'检查组件是否已经安装
Function ifObjInstalled(str)
	ifObjInstalled=hu_isObjInstalled(str)
End Function

'检查目录写入权限
Function ifDirWritable(dir)
	ifDirWritable=hu_isDirWritable(dir)
End Function

'数字加密(beta版) 仅测试过4位数字
Function numEncode(str)
	retn=int(rnd()*90000000)+10000000
	lenr=len(str)
	modn=4'可以存在于application
	keyn=len(wapLast&waplogo) mod modn'可以存在于application
	rndx=int(rnd()*10)
	rndt=rndx mod modn
	abst=abs(rndt-keyn)+1'最大4,最小1
	absr=abs(rndt-lenr)+1'最大str长度,最小1
	absq=abs(abst-absr)+1
	absw=abs(lenr-absr)
	numEncode=left(rndx&mid(retn,1,abst)&lenr&right(str,1)&mid(str,1,absr)&mid(retn&retn,lenr,absq)&mid(str,absr+1,absw)&retn,18)
End Function

'数字解密(beta版)
Function numDecode(str)
	If len(str)<>18 Then numDecode=time_r:Exit Function'假使str必须是18位
	modn=4'可以存在于application
	rndt=int(left(str,1)) mod modn
	keyn=len(wapLast&waplogo) mod modn
	abst=abs(rndt-keyn)+1'最大4,最小1
	lenr=int(mid(str,abst+2,1))
	absr=abs(rndt-lenr)+1'最大str长度,最小1
	absq=abs(abst-absr)+1
	absw=abs(lenr-absr)
	strr=mid(str,abst+3,1)'str right 1
	stra=mid(str,abst+4,absr)
	If absr>lenr Or absr=lenr Then
		str=left(stra,lenr)
	Else
		str=stra&mid(str,abst+4+absr+absq,absw)
	End If
	numDecode=str
End Function

'分析会话
Sub setSessionBySid()
	Dim arr_,style_,sid_
	sid_ = bbsSid
	sid=getFilter(sid_,"guest"&Session.SessionID)'sid = XXXX_1,后面的1为版本号.
	sid_str = sid_ & "=" &sid
	arr_=Split(sid,"_")
	If UBound(arr_)>-1 Then
		sid_val = arr_(0)
	End If
	If UBound(arr_)>0 Then
		style_ = arr_(1)
		If style_ ="1" Or style_="2" Or style_="3" Then wapStyle=style_
	End If
	If wapStyle="1" Then
		If ifWeb Then wapStyle="3"'非wap浏览器访问控制
	End If
	If wapStyle<>"1" Then hu_style = True
End Sub

'判断爬虫，做seo优化及搜索屏蔽功能
Function ifSpider()
	'暂时不作爬虫验证，以提高执行效率
	ifSpider=False:Exit Function
	Dim userSpider:userSpider = Session("user_spider")
	If userSpider="" Then
		If user_array(0)>0 Then
			'已登录用户可跳过判断
			ifSpider=False
			user_spider = 2
			Session("user_spider") = "2"
			Exit Function
		End If
		If user_spider=0 Then'没有session时启用
			Dim agent:agent = LCase(user_agent)
			ifSpider=True
			user_spider = 1
			Session("user_spider") = "1"
			Select Case True
			Case InStr(agent,"spider")>0'其他爬虫
			'百度 baiduspider
			'搜狗 sogou spider
			'爱问 iaskspider
			'Lycos lycos_spider
			Case InStr(agent,"googlebot")>0'谷歌
			Case InStr(agent,"mediapartners-google")>0'Google Adsense
			Case InStr(agent,"msnbot")>0'MSN，必应
			Case InStr(agent,"soso")>0'搜搜
			Case InStr(agent,"yodao")>0'有道
			Case InStr(agent,"outfox")>0'有道
			Case InStr(agent,"sohu")>0'搜狐
			Case InStr(agent,"yahoo")>0'雅虎 yahoo slurp
			' Case InStr(agent,"slurp")>0'雅虎
			'以下是外国爬虫，为提高性能，这里暂不作验证
			' Case InStr(agent,"openbot")>0'Open
			' Case InStr(agent,"fast-webcrawler")>0'Alltheweb
			' Case InStr(agent,"archiver")>0'Alexa
			' Case InStr(agent,"compatible")>0'Alexa'测试用
			' Case InStr(agent,"scooter")>0'Alexa
			' Case InStr(agent,"alexa")>0'Alexa
			' Case InStr(agent,"inktomi")>0'Inktomi
			' Case InStr(agent,"sqworm")>0'AOL
			' Case InStr(agent,"robozilla")>0'Robozilla
			' Case InStr(agent,"survey")>0'Survey
			Case Else
				ifSpider = False
				user_spider = 2
				Session("user_spider") = "2"
			End Select
		Else
			If user_spider=1 Then
				ifSpider=True
			Else
				ifSpider=False
			End If
		End If
	Else
		If userSpider = "1" Then
			ifSpider = True
		Else
			ifSpider = False
		End If
	End If
End Function

'是否支持图片组件aspJpeg
Function ifSusAspJpeg
	On Error Resume Next
	If Application("if_sus_aspjpeg")="" Then
		Application("if_sus_aspjpeg")=ifObjInstalled("Persits.Jpeg")
	End If
	ifSusAspJpeg=Application("if_sus_aspjpeg")
End Function
%>